home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Auge 4000 / Auge 4000 #44 (1990-05-04)(Amiga User Gruppe Einzugsgebiet 4000).zip / Auge 4000 #44 (1990-05-04)(Amiga User Gruppe Einzugsgebiet 4000).adf / Unterhaltung / Sondensuche / Sondensuche (.txt) < prev    next >
AmigaBASIC Source Code  |  1990-05-01  |  8KB  |  253 lines
  1. REM *********************
  2. REM *                   *
  3. REM *    Sondensuche    *
  4. REM *                   *
  5. REM *    (C) 02/1990    *
  6. REM *                   *
  7. REM *    AMIGA-Basic    *
  8. REM *                   *
  9. REM *********************
  10. CLEAR ,30000  
  11. SCREEN 2,320,250,3,1
  12. WINDOW 2,"SONDENSUCHE by Manfred Polzin,AUGE 4000",,16,2
  13. DECLARE FUNCTION OpenDiskFont& LIBRARY
  14. DECLARE FUNCTION CloseFont& LIBRARY
  15. DECLARE FUNCTION SetFont& LIBRARY
  16. LIBRARY"diskfont.library"
  17. LIBRARY"graphics.library"
  18. LoadFont"asc ii/8"
  19. LIBRARY CLOSE
  20. OPEN"Cursor1" FOR INPUT AS 1
  21. OBJECT.SHAPE 1,INPUT$(LOF(1),1):CLOSE 1
  22. OPEN"Cursor2" FOR INPUT AS 1
  23. OBJECT.SHAPE 2,INPUT$(LOF(1),1):CLOSE 1
  24. OPEN"Cursor3" FOR INPUT AS 1
  25. OBJECT.SHAPE 3,INPUT$(LOF(1),1):CLOSE 1
  26. OPEN"Cursor4" FOR INPUT AS 1
  27. OBJECT.SHAPE 4,INPUT$(LOF(1),1):CLOSE 1 
  28. Spielbeginn:
  29. COLOR 0,0:CLS:COLOR 1,0
  30. LOCATE 5,6:PRINT"Wieviele"
  31. LOCATE 7,6:PRINT"Spieler [1 bis 4]?":Spieler=1
  32. Abfrage:
  33. ta$=INKEY$:IF ta$=CHR$(13) THEN Weiter
  34. IF ta$=CHR$(32) THEN CALL Pause:Spieler=Spieler+1
  35. IF Spieler>4 THEN Spieler=1
  36. LOCATE 7,26:PRINT USING"#";Spieler
  37. GOTO Abfrage
  38. Weiter:
  39. LOCATE 11,6:PRINT"Bitte Name[n] eingeben"
  40. LOCATE 12,6:PRINT"   [max. 8 Zeichen]"
  41. FOR i=1 TO Spieler
  42. Eingabe:
  43. LOCATE 12+i*2,6:PRINT"Name"+STR$(i):LOCATE 12+i*2,12:INPUT Vorname$(i)
  44. IF LEN(Vorname$(i))>8 THEN Eingabe
  45. NEXT i
  46. COLOR 2,2:CLS:COLOR 2,6
  47. LOCATE 5,7:PRINT" (  (  (  (  (  (  (  (  ( "
  48. FOR i=6 TO 27 STEP 3:LOCATE i,7:PRINT"+ $& $& $& $& $& $& $& $& )":NEXT i
  49. FOR i=7 TO 25 STEP 3:LOCATE i,7:PRINT" %@-%@-%@-%@-%@-%@-%@-%@-% ":NEXT i
  50. FOR i=8 TO 26 STEP 3:LOCATE i,7:PRINT" #-@#-@#-@#-@#-@#-@#-@#-@# ":NEXT i
  51. LOCATE 28,7:PRINT" *  *  *  *  *  *  *  *  * "
  52. FOR i=1 TO Spieler 
  53. FOR j=1 TO 8:FOR k=1 TO 9:kd(i,j,k)=ASC(CHR$(32)):NEXT k:NEXT j
  54. FOR w=1 TO 4
  55. Zufall:
  56. RANDOMIZE TIMER:j=INT(RND*8)+1:k=INT(RND*9)+1:IF kd(i,j,k)=ASC(CHR$(143)) THEN Zufall
  57. kd(i,j,k)=143
  58. NEXT w:NEXT i
  59. l=5:m=5:FOR i=1 TO Spieler:p(i)=0:x(i)=148:y(i)=132:s(i)=5:t(i)=5:NEXT i
  60. Anfang:
  61. FOR i=1 TO Spieler
  62. GOSUB Verteilen
  63. SOUND 350,2,255
  64. COLOR 2,2:LOCATE 3,7:PRINT SPACE$(28)
  65. COLOR 1,2:LOCATE 3,7:PRINT Vorname$(i)+",du bist jetzt dran!"
  66. Schleife:
  67. OBJECT.X i,x(i):OBJECT.Y i,y(i):OBJECT.STOP 
  68. ri1=STICK(2):ri2=STICK(3):kn=STRIG(2)
  69. IF kn=-1 THEN Naechste
  70. IF ri1=1 THEN Rechts
  71. IF ri1=-1 THEN Links
  72. IF ri2=1 THEN Unten
  73. IF ri2=-1 THEN Oben
  74. FOR d=1 TO 150:NEXT d:OBJECT.OFF i:FOR d=1 TO 150:NEXT d:OBJECT.ON i:OBJECT.STOP
  75. GOTO Schleife
  76. Rechts:
  77. x(i)=x(i)+24:IF x(i)>244 THEN x(i)=244
  78. t(i)=t(i)+1:IF t(i)>9 THEN t(i)=9
  79. m=ti(i):CALL Pause:GOTO Schleife
  80. Links:
  81. x(i)=x(i)-24:IF x(i)<52 THEN x(i)=52
  82. t(i)=t(i)-1:IF t(i)<1 THEN t(i)=1
  83. m=t(i):CALL Pause:GOTO Schleife
  84. Unten:
  85. y(i)=y(i)+24:IF y(i)>204 THEN y(i)=204
  86. s(i)=s(i)+1:IF s(i)>8 THEN s(i)=8
  87. l=s(i):CALL Pause:GOTO Schleife
  88. Oben:
  89. y(i)=y(i)-24:IF y(i)<36 THEN y(i)=36
  90. s(i)=s(i)-1:IF s(i)<1 THEN s(i)=1
  91. l=s(i):CALL Pause:GOTO Schleife
  92. Naechste:
  93. so(i)=0:r=0
  94. symb=kd(i,s(i),t(i))
  95. IF symb>47 AND symb<53 OR symb=142 THEN SOUND 330,2,255:GOTO Schleife
  96. l=s(i):m=t(i)
  97. Zurueck1:
  98. symb=kd(i,l,m)
  99. IF symb=143 AND r=0 THEN OBJECT.OFF i:GOSUB Treffer:GOTO Ueberpruefung
  100. IF symb=142 OR symb=143 THEN so(i)=so(i)+1:l=s(i):m=t(i):GOTO Zurueck2
  101. r=r+1:m=m+1:IF m<10 THEN Zurueck1
  102. l=s(i):m=t(i)
  103. Zurueck2:
  104. symb=kd(i,l,m)
  105. IF symb=142 OR symb=143 THEN so(i)=so(i)+1:l=s(i):m=t(i):GOTO Zurueck3
  106. l=l+1:m=m+1:IF l<9 AND m<10 THEN Zurueck2
  107. l=s(i):m=t(i)
  108. Zurueck3:
  109. symb=kd(i,l,m)
  110. IF symb=142 OR symb=143 THEN so(i)=so(i)+1:l=s(i):m=t(i):GOTO Zurueck4
  111. l=l+1:IF l<9 THEN Zurueck3
  112. l=s(i):m=t(i)
  113. Zurueck4:
  114. symb=kd(i,l,m)
  115. IF symb=142 OR symb=143 THEN so(i)=so(i)+1:l=s(i):m=t(i):GOTO Zurueck5
  116. l=l+1:m=m-1:IF l<9 AND m>0 THEN Zurueck4
  117. l=s(i):m=t(i)
  118. Zurueck5:
  119. symb=kd(i,l,m)
  120. IF symb=142 OR symb=143 THEN so(i)=so(i)+1:l=s(i):m=t(i):GOTO Zurueck6
  121. m=m-1:IF m>0 THEN Zurueck5
  122. l=s(i):m=t(i)
  123. Zurueck6:
  124. symb=kd(i,l,m)
  125. IF symb=142 OR symb=143 THEN so(i)=so(i)+1:l=s(i):m=t(i):GOTO Zurueck7
  126. l=l-1:m=m-1:IF l>0 AND m>0 THEN Zurueck6
  127. l=s(i):m=t(i)
  128. Zurueck7:
  129. symb=kd(i,l,m)
  130. IF symb=142 OR symb=143 THEN so(i)=so(i)+1:l=s(i):m=t(i):GOTO Zurueck8
  131. l=l-1:IF l>0 THEN Zurueck7
  132. l=s(i):m=t(i)
  133. Zurueck8:
  134. symb=kd(i,l,m)
  135. IF symb=142 OR symb=143 THEN so(i)=so(i)+1:l=s(i):m=t(i):GOTO Sonden
  136. l=l-1:m=m+1:IF l>0 AND m<10 THEN Zurueck8
  137. l=s(i):m=t(i)
  138. Sonden:
  139. kd(i,l,m)=so(i)+48
  140. OBJECT.OFF i:COLOR 2,6
  141. IF so(i)=0 THEN GOSUB Nullen
  142. SOUND 200*i,2,255:LOCATE s(i)*3+3,t(i)*3+5:PRINT USING"#";so(i)
  143. Ueberpruefung:
  144. IF p(i)=4 THEN Ende
  145. NEXT i
  146. GOTO Anfang
  147. Treffer:
  148. p(i)=p(i)+1
  149. FOR w1=1 TO 3
  150. FOR j1=220 TO 560 STEP 20:SOUND j1,1,255:NEXT j1
  151. FOR j1=560 TO 220 STEP -20:SOUND j1,1,255:NEXT j1
  152. NEXT w1
  153. COLOR 5,6
  154. LOCATE s(i)*3+3,t(i)*3+5:PRINT CHR$(142):kd(i,s(i),t(i))=142
  155. RETURN
  156. Nullen:
  157. Return1:
  158. m=m+1:IF m<10 THEN symb=ASC(CHR$(kd(i,l,m)))
  159. IF m<10 AND symb>47 AND symb<53 THEN Return1
  160. IF m<10 THEN GOSUB Schwarze:GOTO Return1
  161. l=s(i):m=t(i)
  162. Return2:
  163. l=l+1:m=m+1:IF l<9 AND m<10 THEN symb=ASC(CHR$(kd(i,l,m)))
  164. IF l<9 AND m<10 AND symb>47 AND symb<53 THEN Return2
  165. IF l<9 AND m<10 THEN GOSUB Schwarze:GOTO Return2
  166. l=s(i):m=t(i)
  167. Return3:
  168. l=l+1:IF l<9 THEN symb=ASC(CHR$(kd(i,l,m)))
  169. IF l<9 AND symb>47 AND symb<53 THEN Return3
  170. IF l<9 THEN GOSUB Schwarze:GOTO Return3
  171. l=s(i):m=t(i)
  172. Return4:
  173. l=l+1:m=m-1:IF l<9 AND m>0 THEN symb=ASC(CHR$(kd(i,l,m)))
  174. IF l<9 AND m>0 AND symb>47 AND symb<53 THEN Return4
  175. IF l<9 AND m>0 THEN GOSUB Schwarze:GOTO Return4
  176. l=s(i):m=t(i)
  177. Return5:
  178. m=m-1:IF m>0 THEN symb=ASC(CHR$(kd(i,l,m)))
  179. IF m>0 AND symb>47 AND symb<53 THEN Return5
  180. IF m>0 THEN GOSUB Schwarze:GOTO Return5
  181. l=s(i):m=t(i)
  182. Return6:
  183. l=l-1:m=m-1:IF l>0 AND m>0 THEN symb=ASC(CHR$(kd(i,l,m)))
  184. IF l>0 AND m>0 AND symb>47 AND symb<53 THEN Return6
  185. IF l>0 AND m>0 THEN GOSUB Schwarze:GOTO Return6
  186. l=s(i):m=t(i)
  187. Return7:
  188. l=l-1:IF l>0 THEN symb=ASC(CHR$(kd(i,l,m)))
  189. IF l>0 AND symb>47 AND symb<53 THEN Return7
  190. IF l>0 THEN GOSUB Schwarze:GOTO Return7
  191. l=s(i):m=t(i)
  192. Return8:
  193. l=l-1:m=m+1:IF l>0 AND m<10 THEN symb=ASC(CHR$(kd(i,l,m)))
  194. IF l>0 AND m<10 AND symb>47 AND symb<53 THEN Return8
  195. IF l>0 AND m<10 THEN GOSUB Schwarze:GOTO Return8
  196. RETURN
  197. Schwarze:
  198. kd(i,l,m)=128:RETURN
  199. Verteilen:
  200. FOR j=1 TO 8:FOR k=1 TO 9:COLOR 2,6
  201. LOCATE j*3+3,k*3+5
  202. IF kd(i,j,k)=142 THEN COLOR 5,6
  203. PRINT CHR$(kd(i,j,k))
  204. NEXT k:NEXT j:RETURN
  205. Ende:
  206. FOR i=1 TO Spieler:OBJECT.OFF i:NEXT i 
  207. FOR i=1 TO Spieler
  208. COLOR 2,2:LOCATE 3,7:PRINT SPACE$(28)
  209. COLOR 1,2:LOCATE 3,7:PRINT "Auflösung von "+Vorname$(i)
  210. COLOR 2,6
  211. FOR j=1 TO 8:FOR k=1 TO 9:COLOR 2,6
  212. LOCATE j*3+3,k*3+5
  213. IF kd(i,j,k)=143 THEN COLOR 5,6:PRINT CHR$(127):GOTO Etc
  214. IF kd(i,j,k)=142 THEN COLOR 5,6:PRINT CHR$(142):GOTO Etc
  215. PRINT CHR$(kd(i,j,k))
  216. Etc:
  217. NEXT k:NEXT j
  218. Wiederholung:
  219. ta$=INKEY$:IF ta$="" THEN Wiederholung
  220. IF ta$=CHR$(13) THEN duda
  221. GOTO Wiederholung
  222. duda:
  223. SOUND 230,8
  224. NEXT i
  225. COLOR 2,2:CLS:COLOR 1,2:LOCATE 13,5:PRINT"Noch einmal spielen [J oder N] ?"
  226. Taste:
  227. ta$=INKEY$:IF ta$="" THEN Taste
  228. IF ta$="j" THEN Spielbeginn
  229. IF ta$="n" THEN CLS:LOCATE 14,15:PRINT"Tschüß":END
  230. GOTO Taste
  231. SUB Pause STATIC
  232. FOR verz=1 TO 300:NEXT verz
  233. END SUB
  234. SUB LoadFont(FontName$)STATIC
  235. IF pfont& THEN
  236. g&=CloseFont&(pfont&)
  237. END IF
  238. IF FontName$="" THEN FontName$="topaz/8"
  239. i=INSTR(FontName$,"/")
  240. IF i<>0 THEN
  241. a$=LEFT$(FontName$,i-1)+".font"+CHR$(0)
  242. YSize&=VAL(MID$(FontName$,i+1))
  243. TextAttr&(0)=SADD(a$)
  244. TextAtrr&(1)=YSize&*65536
  245. pfont&=OpenDiskFont&(VARPTR(TextAttr&(0)))
  246. IF pfont& THEN
  247. e&=SetFont&(WINDOW(8),pfont&)
  248. END IF
  249. END IF
  250. END SUB
  251.  
  252.  
  253.